home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
bbs
/
tdk_v136.zip
/
DIGIBORD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-12-26
|
8KB
|
382 lines
{
▀▀▀▀▀▀▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀▀ ▀▀▀▀▀ The DoorKit!
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
The BBS Door Development Kit By The People - For The People!
Feel free to modify or optimize this code at will. All I ask is that if
find a better way to do things (and you will), please send me a copy of
your modifications. Thanks in advance!....Larry L. Athey....}
{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
UNIT DIGIBORD;
INTERFACE
USES DOS;
TYPE
Idarray = ARRAY[1..8] OF CHAR;
VAR
AsyncStat : WORD;
dport_num : INTEGER;
nameptr : ^idarray;
OutReady : BOOLEAN;
FUNCTION Digi_Init_Driver : BOOLEAN;
FUNCTION Digi_Deinit_Driver : BOOLEAN;
FUNCTION Digi_Buffer_Check : BOOLEAN;
PROCEDURE Digi_Send(C : CHAR);
FUNCTION Digi_Receive(VAR C : CHAR) : BOOLEAN;
FUNCTION Digi_Carrier_Present : BOOLEAN;
PROCEDURE Digi_Set_Modem;
FUNCTION Digi_Set_Baud(N : LONGINT ; WordSize : BYTE ; Parity : CHAR ; StopBits : BYTE) : BOOLEAN;
PROCEDURE Digi_Flush_IO;
PROCEDURE Digi_Flush_Input;
PROCEDURE Digi_Flush_Output;
PROCEDURE Digi_Get_Info(VAR DriverName : STRING);
PROCEDURE EnableTimeOutError;
PROCEDURE Digi_Break(StatusCode : WORD);
IMPLEMENTATION
CONST
dtrmask = 1;
rtsmask = 2;
TYPE
BytePtr = ^BYTE;
VAR
EBIOSok,DTRok,RTSok : BOOLEAN;
CharReadyP : BytePtr;
FUNCTION digi_Init_driver : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO { Get Channel Parameters }
BEGIN
ah := $0C;
dx := dport_num;
END;
INTR($14,regs);
IF regs.ah = $FF THEN
digi_init_driver := FALSE
ELSE
digi_init_driver := TRUE;
{ Checks for extended Bios }
asm
mov ah,$F4
mov al,$00
mov dx,dport_num
INT $14
END;
IF regs.ax = $000 THEN
EbiosOk := TRUE
ELSE
EbiosOk := FALSE;
WITH regs DO { checks modem dtr/rts status }
BEGIN
ah := $05;
al := $00;
dx := dport_num;
END;
INTR($14,regs);
IF (regs.bl AND DTRmask) <> $00 THEN
DTRok := TRUE
ELSE
DTRok := FALSE;
IF (regs.bl AND RTSmask) <> $00 THEN
RTSok := TRUE
ELSE
RTSok := FALSE;
OutReady := FALSE;
END;
FUNCTION digi_deinit_driver; { A do nada routine, no deinit calls exist. }
BEGIN
digi_deinit_driver := TRUE;
END;
FUNCTION digi_buffer_check : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $03;
dx := dport_num;
END;
INTR($14,regs);
IF (regs.ah AND $01) <> $00 THEN { data ready bit }
digi_buffer_check := TRUE { checks if byte ready to send }
ELSE
digi_buffer_check := FALSE;
END;
PROCEDURE digi_send(c : CHAR);
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $01;
al := BYTE(c);
dx := dport_num;
END;
INTR($14,regs);
{ bit 5 set on = buffer space avail }
IF (regs.ah AND $20) <> $00 THEN
OutReady := TRUE
ELSE
OutReady := FALSE;
END;
FUNCTION digi_receive(VAR c : CHAR) : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
c := #0;
digi_receive := FALSE;
IF digi_buffer_check THEN
BEGIN
WITH regs DO
BEGIN
ah := $02;
dx := dport_num;
END;
INTR($14,regs);
IF (regs.ah AND $8E) = $00 THEN
BEGIN
c := CHR(regs.al);
digi_receive := TRUE;
END;
END;
END;
FUNCTION digi_carrier_present : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $03;
dx := dport_num;
END;
INTR($14,regs);
IF (regs.al AND $80) <> $00 THEN { carrier present bit }
digi_carrier_present := TRUE
ELSE
digi_carrier_present := FALSE;
IF (regs.ah AND $20) <> $00 THEN { bit 5 set on = buffer space avail }
OutReady := TRUE { thus can check if out buffer ready}
ELSE
OutReady := FALSE;
END;
FUNCTION ExtBaud(n : LONGINT) : BYTE;
VAR
b : BYTE;
w : WORD;
BEGIN
b := $00;
w := n;
IF n > 76800 THEN { 115200 }
b := $0C
ELSE
IF n > 57600 THEN { 76800 }
b := $0B
ELSE
CASE w OF
300 : b := $02;
600 : b := $03;
1200 : b := $04;
1800 : b := $11;
2400 : b := $05;
4800 : b := $06;
4801..9600 : b := $07;
9601..19200 : b := $08;
19201..38400 : b := $09;
38401..57600 : b := $0A;
END;
ExtBaud := b;
END;
PROCEDURE digi_set_modem;
VAR
regs : REGISTERS;
BEGIN
WITH regs DO
BEGIN
dx := dport_num;
ah := $05;
al := $01;
IF dtrok THEN bl := bl OR dtrmask;
IF rtsok THEN bl := bl OR rtsmask;
END;
INTR($14,regs);
END;
{ This is included for completeness only }
{ Most sysops don't want a door to reinitiallize their board }
{ so this is by passed. }
FUNCTION digi_set_baud; { new form digiboard init }
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $04;
al := $00;
dx := dport_num;
CASE parity OF
'N' : bh := $00;
'O' : bh := $01;
'E' : bh := $02;
END; {0 = none/ 1 = odd / 2 = even }
CASE stopbits OF
1 : bl := $00;
2 : bl := $01;
END;
CASE wordsize OF
5 : ch := $00;
6 : ch := $01;
7 : ch := $02;
8 : ch := $03;
END;
cl := ExtBaud(n); { set baud rate }
END;
INTR($14,regs);
IF regs.ah = $FF THEN
digi_set_baud := FALSE
ELSE
BEGIN
digi_set_baud := TRUE;
digi_set_modem;
END;
END;
PROCEDURE digi_flush_io;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $09;
regs.dx := dport_num;
INTR($14,regs);
END;
PROCEDURE digi_flush_input;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $10;
regs.dx := dport_num;
INTR($14,regs);
END;
PROCEDURE digi_flush_output;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $11;
regs.dx := dport_num;
INTR($14,regs);
END;
PROCEDURE digi_Get_Info(VAR drivername : STRING);
CONST
dname : ARRAY[1..5] OF
STRING [6] = ('COM/Xi','MC/Xi', 'PC/Xe', 'PC/Xi', 'PC/Xm' );
VAR
i : BYTE;
regs : REGISTERS;
d,s,o : STRING;
versno : WORD;
BEGIN;
versno := 0;
d := '';s := '';o := ' ';
WITH regs DO
BEGIN
ah := $06;
al := $ff;
dx := dport_num;
END;
INTR($14,regs);
nameptr := PTR(regs.es,regs.bx);
i := 1;
WHILE (i < 8) AND (nameptr^[i] <> #0) DO
INC(i);
MOVE(nameptr^, d[1], i);
d[0] := CHAR(i);
WITH regs DO
BEGIN
ah := $06;
al := $01;
dx := dport_num;
END;
INTR($14,regs);
IF regs.ah <> $ff THEN
BEGIN
versno := regs.bx;
STR(versno,o);
s := ' Version[' + o + '] : ';
STR(regs.ax,o);
END;
d := d + s;
s := '';
WITH regs DO
BEGIN
ah := $06;
al := $02;
bx := $000;
dx := dport_num;
END;
INTR($14,regs);
IF regs.ah <> $ff THEN
IF regs.al IN [$01..$05] THEN s := dname[regs.al]
ELSE STR(regs.al,s);
drivername := d + s + o;
END;
PROCEDURE EnableTimeOutError;
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $20;
al := $01;
dx := dport_num;
END;
INTR($14,regs);
END;
PROCEDURE Digi_Break(StatusCode : WORD); { send break }
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $07;
al := $00; { defaults 250 millisecs }
dx := dport_num;
END;
INTR($14,regs);
AsyncStat := StatusCode;
END;
END.